Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/export1a/clsmerge.cls

Text File | 1999-09-30 | 13KB | 451 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsWordMerge"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'**(CLASS HEADER)*************************************************
'*
'*   Author:  Tmess  EMail: [e-mail]
'*  Purpose:  1.Create New word Document
'*            2.Set the pagesetup and Add text to the document
'*            3.Position and format the text
'*            4.Insert data from a database into the table
'*            5.Save the document
'*            6.Create a new e-mail using outlook
'*            7.Insert the document into an e-mail
'*            8.Send the e-mail
'*            9.Delete the document
'*            10.All errors are logged in a textfile and can be raised in the form
'*
'*  You can use all the above or some
'*
'*  Use this at your own risk. I am not responsible for misuse of this class
'*   Please improve if you want. Let me know
'*
'******************************************************************

Public Enum PageSetups
   Landscape = wdOrientLandscape
   Portrait = wdOrientPortrait
End Enum

Public Enum Alignment
    Center = WdParagraphAlignment.wdAlignParagraphCenter
    Left = WdParagraphAlignment.wdAlignParagraphLeft
    Right = WdParagraphAlignment.wdAlignParagraphRight
    Justify = WdParagraphAlignment.wdAlignParagraphJustify
End Enum

Private m_ProcedureName As String 'Name of current procedure: for error handling
Private m_dbPathName As String 'Path and name of Database
Private m_IsConnected As Boolean 'Is there a connection to database
Private m_NumOfLines As Integer 'Number of blank lines to insert
Private m_StrHyperlink As String 'Name of hyperlink
Private m_Strsubject As String 'Subject of E-mail message
Private m_StrTo As String 'Recipient address
Private m_StrToAdd As String 'Text to add to Word doc
Private m_VarMsgBody As Variant 'Body of e-mail message
Private m_FontSize As Integer 'Font size of StrToAdd
Private m_FontBold As Boolean 'Is strToAdd bold or Not
Private m_ParaAlign As Integer 'StrToAdd alignment SEE ENUM ALIGNMENT
Private m_PageSetup As Integer 'Page setup of Word Doc SEE ENUM PAGESETUPS
Private m_Database As Dao.Database 'DAO database object
Private m_Recordset As Dao.Recordset 'DAO Recordset object
Private m_sql As String 'SQL String passed from client
Private i As Integer 'Used in for next loop

Private wrdApp As Word.Application 'MS Word object
Private wrdDoc As Word.Document 'MS Word Document
Private wrdSelection As Word.Selection 'MS Word Selection
Private strDocName As String 'MS Word document name

'Raised if merge successful
Public Event MergeComplete()
'Raised if merge Unsuccessful
Public Event MergeFailed(errNum As Integer, msgWhy As String)
'Raised if merge document saved successfully
Public Event DocumentSaved()
'Raised if merge document saved Unsuccessfully
Public Event DocumentNotSaved(errNum As Integer, msgWhy As String)
'Raised if document was e-mailed successfully
Public Event MessageSent()
'Raised if document was e-mailed Unsuccessfully
Public Event MessageNotSent(errNum As Integer, msgWhy As String)
'Raised if database connection was successful
Public Event ConnectionSuccessful()
'Raised if database connection was Unsuccessful
Public Event ConnectionNotSuccessful(errNum As Integer, msgWhy As String)
'Raise for unknown errors
Public Event UnknownError(errNum As Integer, msgWhy As String)

Private Sub Class_Initialize()

    Set wrdApp = New Word.Application

    'Set to false if you don't want to see the word doc
    wrdApp.Visible = True
    'Database connection has not been established yet
    m_IsConnected = False
End Sub


Private Sub Class_Terminate()

    wrdApp.Quit
    Set wrdSelection = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing

End Sub
Public Sub OpenNewDoc()

    Set wrdDoc = wrdApp.Documents.Add
    wrdDoc.Select

    Set wrdSelection = wrdApp.Selection

End Sub

Public Property Let PageSetupDocument(IntPageSetup As Integer)

    m_PageSetup = IntPageSetup
    wrdDoc.PageSetup.Orientation = m_PageSetup

End Property

Public Sub DatabaseToConnect(dbPathAndName As String)
On Error GoTo Err_Handler

    'Check to see if a connection to a database is already opened
    If m_IsConnected Then
        MsgBox "Connection already established. Close the current " & _
         "connection first before opening a new database", vbInformation, _
         "Connection Already Established"
        Exit Sub
    End If

    m_dbPathName = dbPathAndName

    'Check to see if the path and the database exists
    If FileExist(m_dbPathName) = False Then
     MsgBox "File Not Found. Could not Establish Connection", vbCritical, _
            "File Not Found"
        Exit Sub
    End If

    Set m_Database = DBEngine.OpenDatabase(m_dbPathName)
    m_IsConnected = True

Exit Sub

Err_Handler:
        m_ProcedureName = "DatabaseToConnect"
        Call ClsErrorHandler

End Sub
Public Sub DatabaseDisConnect()
    'Close and Release database object from memory
    If m_IsConnected Then
        m_Database.Close
        Set m_Database = Nothing
        m_IsConnected = False
        Exit Sub
    End If

End Sub

Public Property Let InsertLinesInDoc(numOfLines As Integer)

    m_NumOfLines = numOfLines
    InsertLines m_NumOfLines

End Property

Public Sub InsertText(strToAdd As String, IntFontSize As Integer, _
    blBold As Boolean, intParagraphAlign As Integer)

    m_StrToAdd = strToAdd
    m_FontBold = blBold
    m_FontSize = IntFontSize
    m_ParaAlign = intParagraphAlign

    InsertTextIntoDoc

End Sub

Public Property Let InsertHyperlinkAddress(strHyperlink As String)

    m_StrHyperlink = strHyperlink
    InsertHyperlink

End Property

Public Sub InsertTableWithData(strRecordSet As String, _
        Optional RecordSetToUse As Dao.Recordset)
On Error GoTo Error_Handler

 Dim intNumofRows As Integer
 Dim intNumofColumns As Integer
 Dim p As Integer, ColWidth As Integer

    'Check to see if a new connection to the database
     'has been established
    If m_IsConnected Then
        m_sql = strRecordSet
        Set m_Recordset = m_Database.OpenRecordset(m_sql)
    Else
        Set m_Recordset = RecordSetToUse
    End If

    m_Recordset.MoveLast
    m_Recordset.MoveFirst

    intNumofColumns = m_Recordset.Fields.Count
    intNumofRows = m_Recordset.RecordCount

    'Insert a new table with rows according to recordCount plus Column header
    'and the number of columns in the recordset

    wrdDoc.Tables.Add wrdSelection.Range, NumRows:=intNumofRows + 1, _
    NumColumns:=intNumofColumns

    With wrdDoc.Tables(1)
    ' Set the column widths
     For i = 0 To intNumofColumns - 1
     ColWidth = Len(m_Recordset.Fields(i).Name)
        .Columns(i + 1).SetWidth ColWidth * 25, wdAdjustNone
        .Cell(1, i + 1).Range.InsertAfter UCase(m_Recordset.Fields(i).Name)
     Next i

        ' Set the shading on the first row to light gray
        .Rows(1).Cells.Shading.BackgroundPatternColorIndex = wdGray25

        ' Bold the first row
        .Rows(1).Range.Bold = True

        ' Center the text in Cell (1,1)
        .Cell(1, 1).Range.Paragraphs.Alignment = wdAlignParagraphCenter

        ' Fill each row of the table with data
        For i = 1 To intNumofRows
         For p = 1 To intNumofColumns
          FillRow i + 1, p, m_Recordset.Fields(p - 1)
         Next p
         p = 1
         m_Recordset.MoveNext
        Next i
    End With

    RaiseEvent MergeComplete

Exit_Handler:

   'release objects from memory
   If m_IsConnected Then
    m_Recordset.Close
   End If

   Set m_Recordset = Nothing